home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / pascal / bp7_os2.zip / COMPATIB.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-10  |  3KB  |  108 lines
  1. Unit Compatib;
  2.  
  3. Interface
  4.  
  5. Const
  6.   FCarry     = $0001;
  7.   FParity    = $0004;
  8.   FAuxiliary = $0010;
  9.   FZero      = $0040;
  10.   FSign      = $0080;
  11.   FOverflow  = $0800;
  12.  
  13. Type
  14.   Registers = Record
  15.                 Case Integer of
  16.                   0: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Word);
  17.                   1: (AL,AH,BL,BH,CL,CH,DL,DH          : Byte);
  18.               End;
  19.  
  20.   { Only the interrupt vectors for INT 0,4,5,6,7,$10 can }
  21.   { be accessed easily.                                  }
  22.  
  23.   Procedure GetIntVec(IntNo : Byte;Var Vector : Pointer);
  24.   Procedure SetIntVec(IntNo : Byte;Vector : Pointer);
  25.   Procedure Intr(IntNo : Byte;Var Regs : Registers);
  26.   Procedure MsDos(Var Regs : Registers);
  27.  
  28. Implementation
  29.  
  30.   Function VioWrtTTY(s : PChar;Len : Word;VioHandle : Word) : Word; Far;
  31.     External 'VIOCALLS' Index 19;
  32.   Function DosSetVec(VecNum : Word;Handler : Pointer;Var PrevHandler : Pointer) : Word; Far;
  33.     External 'DOSCALLS' Index 89;
  34.   Procedure DosWrite(Handle : Word;Var Buf;Count : Word;Var WCount : Word); Far;
  35.     External 'DOSCALLS' Index 138;
  36.  
  37. Type
  38.   TKbdKeyInfo = Record
  39.                   chChar    : Char;
  40.                   chScan    : Char;
  41.                   fbStatus  : Byte;
  42.                   bNlsShift : Byte;
  43.                   fsState   : Word;
  44.                   time      : LongInt;
  45.                 End;
  46.  
  47.   Function KbdPeek(Var KeyInfo : TKbdKeyInfo;KbdHandle : Word) : Word; Far;
  48.     External 'KBDCALLS' Index 22;
  49.  
  50.   Procedure GetIntVec(IntNo : Byte;Var Vector : Pointer);
  51.   Var
  52.     p : Pointer;
  53.   Begin
  54.     Vector := Nil;
  55.     If DosSetVec(IntNo,Nil,p) = 0 then
  56.       Begin
  57.         Vector := p;
  58.         DosSetVec(IntNo,p,p);
  59.       End;
  60.   End;
  61.  
  62.   Procedure SetIntVec(IntNo : Byte;Vector : Pointer);
  63.   Var
  64.     p : Pointer;
  65.   Begin
  66.     DosSetVec(IntNo,Vector,p);
  67.   End;
  68.  
  69.   Procedure Intr(IntNo : Byte;Var Regs : Registers);
  70.   Var
  71.     w : Word;
  72.     KeyInfo : TKbdKeyInfo;
  73.   Begin
  74.     Case IntNo of
  75.       $16 : Case Regs.AH of
  76.               $01 : Begin  { Check for keystroke. }
  77.                       KbdPeek(KeyInfo,0);
  78.                       If (KeyInfo.fbStatus And $40) <> 0 then
  79.                         Begin
  80.                           Regs.Flags := Regs.Flags And Not(FZero);
  81.                           Regs.AL    := Ord(KeyInfo.chChar);
  82.                           Regs.AH    := Ord(KeyInfo.chScan);
  83.                         End
  84.                       else
  85.                         Regs.Flags := Regs.Flags Or FZero;
  86.                       Exit;
  87.                     End;
  88.             End;
  89.       $21 : Case Regs.AH of
  90.               $09 : Begin  { Write string to standard output. }
  91.                       w := 0;
  92.                       While Mem[Regs.DS:Regs.DX + w] <> Ord('$') do Inc(w);
  93.                       DosWrite(1,Ptr(Regs.DS,Regs.DX)^,w,w);
  94.                       Exit;
  95.                     End;
  96.             End;
  97.     End;
  98.     VioWrtTTY('Unsupported INT'^M^J,17,0);
  99.     RunError(99);
  100.   End;
  101.  
  102.   Procedure MsDos(Var Regs : Registers);
  103.   Begin
  104.     Intr($21,Regs);
  105.   End;
  106.  
  107. End.
  108.